home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / terminal / kam510 / kam-rcv.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-26  |  6.7 KB  |  269 lines
  1. procedure capture_on;
  2. begin
  3.   check_if_in_help;
  4.   prompt_color;
  5.   capture_file_name := 'CAPTURE.TMP';
  6.   Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  7.   SayGet(20,status_line,'Capture File (or ?) ',capture_file_name,_S,24,1);
  8.   WatchKeys := ['?'];
  9.   ReadGets;
  10.   if LastKey = '?' then capture_file_name := PickFile('*.*');
  11.   if (capture_file_name <> '')
  12.   then
  13.   begin
  14.     assign(capture_file,capture_file_name);
  15.     {$I-}
  16.     rewrite(capture_file);
  17.     if (IOresult <> 0)
  18.     then begin
  19.            gotoxy(20,status_line); status_color;
  20.            write('Unable to open ',capture_file_name,^G^G^G);
  21.            delay(1000);
  22.            close(capture_file);
  23.          end;
  24.     capture := TRUE;
  25.     sho_status;
  26.   end;
  27. end;
  28.  
  29. procedure capture_off;
  30. begin
  31.   writeln(capture_file, rcv_buffer[buf_cnt]^);
  32.   close(capture_file);
  33.   capture := FALSE;
  34.   sho_status;
  35. end;
  36.  
  37. procedure init_rcv_buffers;
  38. var i : integer;
  39. begin
  40.   for i := 1 to max_rcv_buffers do
  41.     rcv_buffer[i]^[0] := chr(0);
  42.   rcv_cnt := 0;
  43.   buf_cnt := 1;
  44. end;
  45.  
  46. procedure update_buffer(c : char);
  47. var i : integer;
  48. begin
  49.   if c <> #13 then
  50.   begin
  51.     inc(rcv_cnt);
  52.     rcv_buffer[buf_cnt]^[rcv_cnt] := c;
  53.     rcv_buffer[buf_cnt]^[0] := chr(rcv_cnt);
  54.   end
  55.   else
  56.   begin
  57.     if (capture = TRUE) then writeln(capture_file,rcv_buffer[buf_cnt]^);
  58.     inc(buf_cnt);
  59.     if (buf_cnt > max_rcv_buffers) then buf_cnt := 1;
  60.     rcv_cnt := 0;
  61.     rcv_buffer[buf_cnt]^[0] := chr(rcv_cnt);
  62.   end;
  63. end;
  64.  
  65. procedure next_line;
  66. begin
  67.   if yin = inp_end_line
  68.     then begin
  69.            window(1, inp_start_line, 80, inp_end_line );
  70.            gotoxy(1,1); DelLine;
  71.            full_window;
  72.            xin := 1;
  73.            gotoxy(xin,yin);
  74.          end
  75.     else begin
  76.            yin := yin + 1;
  77.            xin := 1;
  78.            gotoxy(xin,yin);
  79.          end;
  80. end;
  81.  
  82. procedure show_inp(st: char);
  83. var i,n,p: integer;
  84. begin
  85.   if st = #00 then exit;
  86.   receive_color;
  87.   if (rcv_cnt = 80) then
  88.   case st of
  89.     '!'..'z': begin
  90.                 n := 0;
  91.                 p := 81;
  92.                 repeat
  93.                   n := n + 1;
  94.                   p := (p-1);
  95.                 until (rcv_buffer[buf_cnt]^[p] = ' ') OR
  96.                       (p = 0);
  97.                 p := p + 1;
  98.                 n := n - 1;
  99.                 if n in [1..10]
  100.                 then
  101.                   begin
  102.                     tmpstr := '';
  103.                     gotoxy(xin - n, yin);
  104.                     ClrEol;
  105.                     next_line;
  106.                     rcv_buffer[buf_cnt]^[0] := chr(81 - n);
  107.                     while (n > 0) do
  108.                     begin
  109.                       tmpstr := tmpstr + rcv_buffer[buf_cnt]^[p];
  110.                       write(rcv_buffer[buf_cnt]^[p]);
  111.                       inc(p);
  112.                       dec(n);
  113.                       inc(xin);
  114.                     end;
  115.                     update_buffer(#13);
  116.                     for i := 1 to length(tmpstr) do
  117.                       update_buffer(tmpstr[i]);
  118.                   end
  119.                 else
  120.                   begin
  121.                     next_line;
  122.                     update_buffer(#13);
  123.                   end;
  124.               end;
  125.     ' ' : begin
  126.             next_line;
  127.             update_buffer(#13);
  128.           end;
  129.   end;
  130.   gotoxy(xin,yin);
  131.   case st of
  132.     #13 : begin
  133.             update_buffer(#13);
  134.             next_line;
  135.           end;
  136.     #10 : ;
  137.     else begin
  138.            write(st);
  139.            xin := xin + 1;
  140.            update_buffer(st);
  141.          end;
  142.   end;
  143.   if (st = #32) AND (mode = CW)
  144.   then begin
  145.          rcv_stat;
  146.          disp_rcv_wpm;
  147.        end;
  148. end;
  149.  
  150. var LastRcvChar : char;
  151.  
  152. procedure rcvg;
  153. var ThisChar : char;
  154. begin
  155.   if char_ready then
  156.   begin
  157.     ThisChar := kam_in;
  158.     show_inp(ThisChar);
  159.     if (mode = AMTOR) AND (LastRcvChar = '+') AND (ThisChar = '?')
  160.         then state := transmit;
  161.     LastRcvChar := ThisChar;
  162.   end;
  163. end;
  164.  
  165. procedure show_page(n : integer);
  166. var i,j : integer;
  167. begin
  168.   window(1,inp_start_line,80,inp_end_line);
  169.   clrscr;
  170.   window(1,inp_start_line,80,inp_end_line + 1);
  171.   gotoxy(1,1);
  172.   if (buf_cnt > nlines) then
  173.     for i := n to n + nlines - 1 do
  174.       begin
  175.         if buf_cnt > nlines then
  176.           if ( i > buf_cnt)
  177.             then j := i- buf_cnt
  178.             else j := i;
  179.           if (length(rcv_buffer[j]^) = 80)
  180.             then write(rcv_buffer[j]^)
  181.             else writeln(rcv_buffer[j]^);
  182.       end
  183.   else
  184.     for i := 1 to buf_cnt do
  185.       if (length(rcv_buffer[i]^) = 80)
  186.         then write(rcv_buffer[i]^)
  187.         else writeln(rcv_buffer[i]^);
  188.   window(1,inp_start_line,80,inp_end_line);
  189.   gotoxy(1,1);
  190. end;
  191.  
  192. procedure scrollup;
  193. begin
  194.   if (buf_cnt <= nlines) then exit;
  195.   if ((first + nlines) = buf_cnt) then exit;
  196.   window(1,inp_start_line,80,inp_end_line);
  197.   gotoxy(1,1);
  198.   DelLine;
  199.   inc(first);
  200.   window(1,inp_start_line,80,inp_end_line + 1);
  201.   gotoxy(1,nlines);
  202.   if (length(rcv_buffer[first+nlines]^) = 80)
  203.     then write(rcv_buffer[first+nlines]^)
  204.     else writeln(rcv_buffer[first+nlines]^);
  205.   window(1,inp_start_line,80,inp_end_line);
  206.   gotoxy(1,1);
  207. end;
  208.  
  209. procedure scrolldwn;
  210. begin
  211.   if (first = 1) then exit;
  212.   window(1,inp_start_line,80,inp_end_line);
  213.   gotoxy(1,1);
  214.   InsLine;
  215.   dec(first);
  216.   gotoxy(1,1);
  217.   writeln(rcv_buffer[first]^);
  218.   gotoxy(1,1);
  219. end;
  220.  
  221. procedure review_rcv_buffer;
  222. var i : integer;
  223.     OldVideo : array[1..2000] of word;
  224.     RevKey : char;
  225. begin
  226.   nlines := inp_end_line - inp_start_line + 1;
  227.   first := 1;
  228.   if (buf_cnt = 0) AND (rcv_cnt = 0) then exit;
  229.   FillPage(@OldVideo);
  230.   gotoxy(1,status_line);
  231.   status_color;
  232.   ClrEol;
  233.   write('  HOME start   END end   PGUP   PGDWN    Scroll Up    Scroll Dwn   ESC return ');
  234.   receive_color;
  235.   show_page(first);
  236.   repeat
  237.     repeat
  238.       RevKey := readkey;
  239.     until RevKey in [#0,#27];
  240.     if RevKey = #0 then  RevKey := readkey;
  241.     case RevKey of
  242.       #71 : begin            { HOME }
  243.               first := 1;
  244.               show_page(first);
  245.             end;
  246.       #79 : begin            { END }
  247.               first := buf_cnt - nlines + 1;
  248.               if first < 1 then first := 1;
  249.               show_page(first);
  250.             end;
  251.       #73 : begin            { PGUP }
  252.               first := first  + nlines;
  253.               if (first >= buf_cnt) then first := buf_cnt - nlines + 1;
  254.               show_page(first);
  255.             end;
  256.       #81 : begin            { PGDWN }
  257.               first := first - nlines;
  258.               if (first < 1) then first := 1;
  259.               show_page(first);
  260.             end;
  261.       #72 : scrollup;
  262.       #80 : scrolldwn;
  263.     end;
  264.   until RevKey = #27;
  265.   DisPlayPage(@OldVideo);
  266.   window(1,1,80,25);
  267. end;
  268.  
  269.